CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/swags_z.zip/TSR.SWG/0016_Screen Saver TSR.pas

Pascal/Delphi Source File | 1993-11-02 | 7KB | 211 lines

{
From: ANDREW KEY
Subj: Screen Save
}

unit Scrnsavr;
{$F+}
(*************************************************************************)
(*                        Screen Saver                                   *)
(*                                                                       *)
(*  Written by Jay A. Key -- Oct 1993                                    *)
(*  Code may be modified and used freely.  Please mention my name        *)
(*  somewhere in your docs or in the program itself.                     *)
(*                                                                       *)
(*  Self contained unit to install a text-mode screen saver in Turbo     *)
(*  Pascal programs.  Simply include the following line in your code.    *)
(*    uses ScrnSavr;                                                     *)
(*                                                                       *)
(*  It will initialize itself automatically, and will remove itself      *)
(*  upon exit from your program, graceful exit or not.  Functions        *)
(*  SetTimeOut and SetDelay are included if you wish to modify the       *)
(*  default values.                                                      *)
(*                                                                       *)
(*  Warning: will not properly save and restore screens while running    *)
(*  under the Turbo Pascal IDE.  Runs great from DOS.                    *)
(*************************************************************************)

interface

uses Dos,Crt;

function NumRows: byte;          {Returns number of rows in current screen}
function ColorAdaptor: boolean;  {TRUE if color video card installed}
procedure SetTimeOut(T: integer); {Delay(seconds) before activation}
procedure SetDelay(T: integer);  {Interval between iterations}

(************************************)

implementation

type
  VideoArray = array[1..2000] of word;  {buffer to save video screen}

var
  Timer: word;
  Waiting: boolean;
  OldInt15,                  {Keyboard interrupt}
  OldInt1C,                  {Timer interrupt}
  OldInt23,                  {Cntl-C/Cntl-Break handler}
  ExitSave: pointer;
  Position, Cursor: integer; {save and restore cursor positions}
  VideoSave: VideoArray;
  VideoMem: ^VideoArray;
  TimeOut, Delay: integer;

procedure JumpToPriorIsr(p: pointer);
{Originally written by Brook Monroe, "An ISR Clock", pg. 64,
 PC Techniques Aug/Sep 1992}
  inline($5b/$58/$87/$5e/$0e/$87/$46/$10/$89/$ec/$5d/$07/$1f/
         $5f/$5e/$5a/$59/$cb);

function ColorAdaptor: boolean; assembler;
  asm
    int 11                   {BIOS call - get equipment list}
    and al,$0010             {mask off all but bit 4}
    xor al,$0010             {flip bit 4 - return val is in al}
  end;

function NumRows: byte; assembler;  {returns number of displayable rows}
  asm
    mov ax,$40
    mov es,ax
    mov ax,$84
    mov di,ax
    mov al,[es:di]           {byte at [$40:$84] is number of rows in display}
  end;

procedure HideCursor; assembler;
  asm
    mov ah,$03
    xor bh,bh
    int $10               {video interrupt}
    mov Position,dx       {save cursor position}
    mov Cursor,cx         {and type}
    mov ah,$01
    mov ch,$20
    int $10               {video interrupt - hide cursor}
  end;

procedure RestoreCursor; assembler;
  asm
    mov ah,$02
    xor bh,bh
    mov dx,Position       {get old position}
    int $10               {video interrupt - restore cursor position}
    mov cx,Cursor         {get old cursor type}
    mov ah,$01
    int $10               {video interrupt - restore cursor type}
  end;

procedure RestoreScreen;
  begin
    VideoMem^ := VideoSave;  {Copy saved image back onto video memory}
    RestoreCursor;
  end;

procedure SaveScreen;
  begin
    VideoSave := VideoMem^;  {Copy video memory to array}
    HideCursor;
  end;

procedure DispMsg;  {simple stub-out for displaying YOUR message(s),
                     pictures, etc...use your imagination!!!}
  begin
    ClrScr;
    GotoXY(random(50),random(23));
    writeln('This would normally be something witty!');
  end;

procedure NewInt15(Flags,CS,IP,AX,BX,CX,DX,
                   SI,DI,DS,ES,BP:WORD); interrupt; {keyboard handler}
  begin
    Timer:=0;                     {Reset timer}
    if Waiting then               {Screen saver activated?}
      begin
        RestoreScreen;            {Restore saved screen image}
        Waiting:= FALSE;          {De-activate screen saver}
        Flags:=(Flags and $FFFE); {Tell BIOS to ignore current keystroke}
      end
    else
      JumpToPriorISR(OldInt15);   {call original int 15}
  end;

procedure NewInt1C; interrupt;    {timer interrupt}
  begin
    Inc(Timer);                   {Increment timer}
    if Timer>TimeOut then         {No key hit for TimeOut seconds?}
      begin
        Waiting := TRUE;          {Activate screen saver}
        SaveScreen;               {Save image of video memory}
        DispMsg;                  {Display your own message}
        Timer := 0;               {Reset timer}
      end;
    if waiting then               {Is saver already active?}
      begin
        if Timer>Delay then       {Time for next message?}
          begin
            Timer := 0;           {Reset timer}
            DispMsg;              {Display next message}
          end;
      end;
    JumpToPriorISR(OldInt1C);     {Chain to old timer interrupt}
  end;

procedure ResetIntVectors;        {Restores Intrrupt vectors to orig. values}
  begin
    SetIntVec($15,OldInt15);
    SetIntVec($1C,OldInt1C);
    SetIntVec($23,OldInt23);
  end;

procedure NewInt23; interrupt;    {Called to handle cntl-c/brk}
  begin
    ResetIntVectors;              {Restore old interrupt vectors}
    JumpToPriorISR(OldInt23);     {Chain to original int 23h}
  end;

procedure MyExit; far;            {exit code for unit}
  begin
    ResetIntVectors;              {Restore old interrupt vectors}
    ExitProc:=ExitSave;           {Restore old exit code}
  end;

procedure SetVideoAddress;        {Returns pointer to text video memory}
  begin
    if ColorAdaptor then
      VideoMem := ptr($B000,$0000)
    else
      VideoMem := ptr($B800,$0000);
  end;

procedure SetTimeOut(T: integer); {Set delay(seconds) before activation}
  begin
    TimeOut:=Round(T*18.2);
  end;

procedure SetDelay(T: integer);  {Set interval between iterations}
  begin
    Delay:=Round(T*18.2);
  end;

{Initialize unit}
begin
  SetVideoAddress;             {Set up address for video memory}
  Waiting := FALSE;            {Screen saver initially OFF}
  Timer := 0;                  {Reset timer}
  ExitSave := ExitProc;        {Save old exit routine}
  ExitProc := @MyExit;         {Install own exit routine}
{Install user defined int vectors}
  GetIntVec($15,OldInt15);     {Keyboard handler}
  SetIntVec($15,@NewInt15);
  GetIntVec($1c,OldInt1C);     {Timer int}
  SetIntVec($1c,@NewInt1C);
  GetIntVec($23,OldInt23);     {Cntl-C/Brk handler}
  SetIntVec($23,@NewInt23);
  SetTimeOut(120);
  SetDelay(15);
end.